home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d13
/
oct90.arc
/
FENCE.LSP
next >
Wrap
Text File
|
1990-11-01
|
7KB
|
168 lines
; FENCE.LSP [Article Figure 2] (c)1990, Tony Sheving
(defun fence ( / boundry ptlist xlist ylist cnt etype pt lowx highx
lowy highy pt1 sset elist ptcnt intcnt pt2 pt3 pt4)
(setq boundry (entget (car (entsel "Select polyline boundary: ")))
ptlist ()
xlist ()
ylist ()
cnt -1)
(if boundry (setq etype (cdr (assoc 0 boundry))))
(if (= etype "POLYLINE")
(if (= (cdr (assoc 70 boundry )) 1)
(while (and (/= (cdr (assoc 0 boundry)) "SEQEND")
(setq boundry (entget (entnext (cdr (assoc -1 boundry))))))
(if (cdr (assoc 10 boundry))
(progn
(setq lastpt hilite
hilite (cdr (assoc 10 boundry)))
(if lastpt (grdraw hilite lastpt 1 -1))
(setq ptlist (cons (cdr (assoc 10 boundry)) ptlist))
) ;end progn
) ;end if
) ;end while
(prompt "\nBoundary is not a closed polyline.\n")
)
(prompt "\nBoundary is not a polyline.\n")
)
(prompt "\nPlease wait... checking for entities within boundary.\n")
(foreach pt ptlist (setq xlist (cons (car pt) xlist)))
(foreach pt ptlist (setq ylist (cons (cadr pt) ylist)))
(setq lowx (apply 'min xlist) highx (apply 'max xlist)
lowy (apply 'min ylist) highy (apply 'max ylist)
pt1 (list (- lowx 10000.0)(- lowy 10000.0))
entset (ssget "C" (list lowx lowy) (list highx highy)))
(ssdel (cdr (assoc -1 boundry)) entset)
(setq sset (sslength entset))
(repeat sset
(setq elist (entget (ssname entset (setq cnt (1+ cnt))))
etype (cdr (assoc 0 elist)))
(cond
((or (= etype "INSERT")(= etype "POINT")(= etype "TEXT"))
(setq ptcnt 0 intcnt 0
pt2 (cdr (assoc 10 elist))
pt3 (nth 0 ptlist)
pt4 (nth (1- (length ptlist)) ptlist))
(repeat (length ptlist)
(if (inters pt1 pt2 pt3 pt4) (setq intcnt (1+ intcnt)))
(setq pt3 (nth ptcnt ptlist)
ptcnt (1+ ptcnt)
pt4 (nth ptcnt ptlist))
)
(if (or (= intcnt 0) (= (rem intcnt 2) 0))
(progn
(ssdel (ssname entset cnt) entset)
(setq cnt (1- cnt))
)
)
) ;end cond insert or point or text
((= etype "LINE")
(setq ptcnt 0 intcnt 0 delflag nil
pt2 (cdr (assoc 10 elist))
pt2a (cdr (assoc 11 elist))
pt3 (nth 0 ptlist)
pt4 (nth (1- (length ptlist)) ptlist))
(repeat (length ptlist) ; check for intersections between line & pline
(if (and (= delflag nil) (inters pt2 pt2a pt3 pt4))
(progn
(ssdel (ssname entset cnt) entset)
(setq cnt (1- cnt)
delflag t)
) ;end progn
(progn
(setq pt3 (nth ptcnt ptlist)
ptcnt (1+ ptcnt)
pt4 (nth ptcnt ptlist))
) ;end progn
) ;end if intersection
) ;end repeat
(if (= delflag nil)
(progn
(setq ptcnt 0 intcnt 0
pt3 (nth 0 ptlist)
pt4 (nth (1- (length ptlist)) ptlist))
(repeat (length ptlist) ;check intersections of 1st point of line
(if (inters pt1 pt2 pt3 pt4) (setq intcnt (1+ intcnt)))
(setq pt3 (nth ptcnt ptlist)
ptcnt (1+ ptcnt)
pt4 (nth ptcnt ptlist))
) ;end repeat
(if (or (= intcnt 0) (= (rem intcnt 2) 0)) ;if intersect even number
(progn ; then 1st point of line is not within boundary
(ssdel (ssname entset cnt) entset)
(setq cnt (1- cnt) delflag t)
)
(setq delflag nil)
) ;enf if even number of intersections
) ;end progn if delflag set
) ;end if
) ;end cond line
((= etype "POLYLINE")
(setq pt2list ())
(while (and (/= (cdr (assoc 0 elist)) "SEQEND")
(setq elist (entget (entnext (cdr (assoc -1 elist))))))
(if (cdr (assoc 10 elist))
(setq pt2list (cons (cdr (assoc 10 elist)) pt2list))
) ;end if
) ;end while
(setq ptcnt 0 pt2cnt 0 intcnt 0 delflag nil
pt2 (nth 0 pt2list)
pt2a (nth (1- (length pt2list)) pt2list))
(repeat (length pt2list)
(setq pt3 (nth 0 ptlist)
pt4 (nth (1- (length ptlist)) ptlist))
(repeat (length ptlist) ; check for intersection between pline & pline
(if (and (= delflag nil) (inters pt2 pt2a pt3 pt4))
(progn
(ssdel (ssname entset cnt) entset)
(setq cnt (1- cnt)
delflag t)
) ;end progn
(progn
(setq pt3 (nth ptcnt ptlist)
ptcnt (1+ ptcnt)
pt4 (nth ptcnt ptlist))
) ;end progn
) ;end if intersection
) ;end repeat
(setq pt2 (nth pt2cnt pt2list)
ptcnt 0
pt2cnt (1+ pt2cnt)
pt2a (nth pt2cnt pt2list))
) ;end repeat
(if (= delflag nil)
(progn
(setq ptcnt 0 intcnt 0
pt3 (nth 0 ptlist)
pt4 (nth (1- (length ptlist)) ptlist))
(repeat (length ptlist) ;check intersections of 1st point of line
(if (inters pt1 pt2 pt3 pt4) (setq intcnt (1+ intcnt)))
(setq pt3 (nth ptcnt ptlist)
ptcnt (1+ ptcnt)
pt4 (nth ptcnt ptlist))
) ;end repeat
(if (or (= intcnt 0) (= (rem intcnt 2) 0)) ;if intersect even number
(progn ; then 1st point of line is not within boundary
(ssdel (ssname entset cnt) entset)
(setq cnt (1- cnt) delflag t)
) ;end progn
) ;enf if even number of intersections
) ;end progn if delflag set
) ;end if
) ;end cond pline
(t
(ssdel (ssname entset cnt) entset)
(setq cnt (1- cnt))
) ;end cond other entity types
) ;end cond
) ;end repeat sset
(if (> (sslength entset) 0)
(setq entset entset)
(prin1 "\n0 entities found. \n")
)
) ;end defun